home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok11 / r.o.m. / m2sources / graph.mod < prev    next >
Text File  |  1993-11-04  |  52KB  |  1,534 lines
  1. IMPLEMENTATION MODULE Graph;
  2. (*
  3.   Created: 02/88
  4.   Changed: 08.02.88/03.03.88/10.3.88/29.3.88/5.8.88/10.9.88 by 
  5.              Stefan Salewski
  6.              Stolper Weg 3
  7.              2160 Stade   West-Germany
  8.              Tel: 04141/61130
  9.              
  10.   Note: compiled with AMIGA Modula-2 System by AMSoft version from 5.5.88
  11. *) 
  12.   FROM Arts IMPORT Assert,TermProcedure;
  13.   FROM MyMathLibLong IMPORT unit,AngleUnit;
  14.   FROM Formelauswertung IMPORT AssignFFP,FFPBerechnung,ClearVar,varListFFP,
  15.                                DefFormel,Formelnummer;
  16.   FROM Exec IMPORT GetMsg,ReplyMsg,MessagePtr,WaitPort,CopyMem,MemReqs,
  17.                    MemReqSet,AllocMem,UByte;
  18.   FROM Dos IMPORT Delay;
  19.   FROM InputEvent IMPORT Qualifiers,QualifierSet;
  20.   FROM Intuition IMPORT NewWindow,WindowPtr,SetMenuStrip,MenuPtr,selectDown,
  21.     WindowToFront,WindowToBack,MenuItemPtr,menuNull,Border,DrawBorder,
  22.     ItemAddress,IDCMPFlagSet,IntuiMessagePtr,IntuiText,PrintIText,selectUp,
  23.     CloseWindow,IDCMPFlags,WindowFlagSet,ModifyIDCMP,ReportMouse,SetPointer,
  24.     WindowFlags,ScreenFlagSet,ScreenFlags,OpenWindow,ClearMenuStrip,
  25.     ClearPointer,SizeWindow,DisplayBeep,ActivateWindow;
  26.   FROM Graphics IMPORT jam1,SetDrMd,Move,Draw,SetAPen,SetBPen,RectFill;
  27.   FROM MyRemember IMPORT RememberNodePtr;
  28.   FROM MakeMenu IMPORT MenuRecord,InitMenu,FreeMenu,MenuNum,ItemNum,SubNum;
  29.   FROM StringInput IMPORT Datum,Buffer,AskForStrings;
  30.   FROM Preference IMPORT CharSize;
  31.   FROM MyStrings IMPORT Assign;
  32.   FROM StringInOut IMPORT OpenNewWindow,CloseNewWindow,ReadString,SetPos,
  33.                           WriteString,inputOK,Flags,FlagSet,ClearWindow;
  34.   FROM FormelausFText IMPORT GetFehlertext;
  35.   FROM SYSTEM IMPORT FFP, BYTE,ADR,ADDRESS,REG;
  36.   FROM Printer IMPORT Special,SpecialSet;
  37.   FROM Conversions IMPORT StrToVal,ValToStr;
  38.   FROM Hardcopy IMPORT DumpRPort;
  39.   FROM MyFFPConversions IMPORT RealToStr;
  40.     
  41.   VAR
  42.     wPtr:WindowPtr;
  43.     rememberkey:RememberNodePtr;
  44.     eingaben:ARRAY[0..3] OF Datum;
  45.   PROCEDURE CleanupGraph;
  46.   BEGIN
  47.     IF wPtr#NIL THEN
  48.       ClearMenuStrip(wPtr);
  49.       IF rememberkey#NIL THEN
  50.         FreeMenu(rememberkey);
  51.         rememberkey:=NIL
  52.       END;
  53.       CloseWindow(wPtr);
  54.       wPtr:=NIL
  55.     END
  56.   END CleanupGraph;    
  57.     
  58.   PROCEDURE Graf;
  59.     CONST
  60.       zwei=2;
  61.       MaxHorzRes=640;
  62.       Zahlenstellen=9;
  63.       DeziStellen=3;
  64.       MaxRaster=8;
  65.       OutOfRange=1001;(* spezielle Fehlernummern*)
  66.       OutOfDefArea=1002;
  67.     TYPE 
  68.       TypA=(mmDef,mmVar,defDef,defVar);
  69.       TypB=(vertC,vertV,horzC,horzV);
  70.       Bildsp= RECORD
  71.                 xWert:FFP;
  72.                 wert:FFP;
  73.                 intWert:[-1..512];   
  74.                 fN:CARDINAL;
  75.               END;
  76.       Formelstring=ARRAY UByte OF CHAR;
  77.       
  78.     VAR
  79.       actWSize:INTEGER;
  80.       maxVertRes:INTEGER;
  81.       charWidth,charHeight,vertRes,horzRes:INTEGER;
  82.       ffpVertRes:FFP;
  83.       startw,endw:FFP;
  84.       firstMenu:MenuPtr;
  85.       j:[0..MaxHorzRes];
  86.       bildspeicher:ARRAY[0..MaxHorzRes] OF Bildsp;
  87.       max,newMax,min,newMin:FFP;
  88.       c:CHAR;
  89.       raster:[-1..MaxRaster];(* Raster:=4 <=> Jeder 4. Punkt wird berechnet   *)
  90.       newW:NewWindow;
  91.       onlyLong:BOOLEAN;
  92.       ende:BOOLEAN;
  93.       minMaxFest:BOOLEAN;
  94.       minMaxDef:BOOLEAN;(* Min und Max wurde eingegeben*)
  95.       firstTime:BOOLEAN;
  96.       horzVersch,vertVersch:[-1..99];
  97.       xLinePos,yLinePos:INTEGER;
  98.       rahmen,gitter,beschriftung:BOOLEAN;
  99.       backgroundColor,drawingColor,textColor:[0..3];
  100.       density:SpecialSet;
  101.       standartXSize,standartYSize:[1..4];
  102.       xUnterteilung,yUnterteilung:UByte;
  103.       defAreaSet:BOOLEAN;
  104.       def1,def2:FFP;
  105.       
  106.   (*************************************************************************) 
  107.     PROCEDURE FFPToStr(x:FFP;VAR str:ARRAY OF CHAR;left:BOOLEAN);
  108.     (* Wenn ABS(x)<1.0 dann wird Exponentialdarstellung gewaehlt *)
  109.     VAR exp,l:[-1..1];
  110.     BEGIN
  111.       IF ABS(x)< 1.0 THEN
  112.         exp:=-1
  113.       ELSE
  114.         exp:=1
  115.       END;
  116.       IF left THEN
  117.         l:=-1
  118.       ELSE
  119.         l:=1
  120.       END;
  121.       RealToStr(x,str,l*DeziStellen,exp*DeziStellen);
  122.     END FFPToStr;
  123.   (*************************************************************************) 
  124.     PROCEDURE GetIntervall(s1,s2:Buffer;VAR x1,x2:FFP):BOOLEAN;
  125.       VAR fN:CARDINAL;
  126.     BEGIN
  127.       fN:=1; (* muss #0 sein *)
  128.       IF DefFormel(9,s1,TRUE,onlyLong)=0 THEN
  129.         FFPBerechnung(9,x1,fN);
  130.         IF fN=0 THEN
  131.           IF DefFormel(9,s2,TRUE,onlyLong)=0 THEN
  132.                FFPBerechnung(9,x2,fN);
  133.           END; 
  134.         END;
  135.       END;
  136.       RETURN (fN=0) AND (x1<x2);
  137.     END GetIntervall;
  138. (*************************************************************************)
  139.     PROCEDURE GetFormel(nummer:Formelnummer;s:Buffer):CARDINAL;
  140.     BEGIN
  141.       RETURN DefFormel(nummer,s,TRUE,onlyLong);
  142.     END GetFormel;
  143. (*************************************************************************)
  144.     PROCEDURE GetLaufvariable(s:Buffer):BOOLEAN;
  145.     BEGIN
  146.       RETURN ((s[1]= 0C) AND AssignFFP(s[0],0.0));
  147.     END GetLaufvariable;
  148. (*************************************************************************)
  149.     PROCEDURE OpenGraphicWindow;
  150.     BEGIN
  151.       WITH newW DO
  152.         leftEdge:=0;
  153.         topEdge:=0;
  154.         width:=MaxHorzRes;
  155.         height:=maxVertRes;
  156.         detailPen:=0;
  157.         blockPen:=1;
  158.         idcmpFlags:=IDCMPFlagSet{menuPick};
  159.         flags:=WindowFlagSet{activate,borderless,noCareRefresh,windowDepth};
  160.         type:=ScreenFlagSet{wbenchScreen};
  161.         firstGadget:=NIL;
  162.         checkMark:=NIL;
  163.         title:=NIL;
  164.         screen:=NIL;
  165.         bitMap:=NIL;
  166.         minWidth:=640;
  167.         minHeight:=256;
  168.         maxWidth:=640;
  169.         maxHeight:=512;
  170.       END;
  171.       wPtr:=OpenWindow(newW);
  172.       Assert(wPtr#NIL,ADR('Graph:Cannot Open Window'));
  173.     END OpenGraphicWindow;
  174. (*************************************************************************)
  175.     PROCEDURE Init;
  176.     BEGIN     
  177.       raster:=1;
  178.       ende:=FALSE;
  179.       minMaxFest:=FALSE;
  180.       minMaxDef:=FALSE;
  181.       xUnterteilung:=255;
  182.       yUnterteilung:=255;
  183.       firstTime:=TRUE;
  184.       backgroundColor:=0;
  185.       drawingColor:=1;
  186.       textColor:=1;
  187.       gitter:=FALSE;
  188.       rahmen:=TRUE;
  189.       beschriftung:=TRUE;
  190.       defAreaSet:=FALSE;
  191.       maxVertRes:=180;(*wird spaeter auf WBScreenHeight vergroessert (wg USA)*)
  192.       density:=SpecialSet{};
  193.       standartXSize:=1;
  194.       standartYSize:=1;
  195.       onlyLong:=FALSE;
  196.       unit:=rad;
  197.     END Init;
  198. (*************************************************************************)
  199.     PROCEDURE InitGraphicmenu;
  200.       VAR
  201.         menurecords:ARRAY[0..3] OF MenuRecord;
  202.     BEGIN
  203.       WITH menurecords[0] DO
  204.         mname:='Aktionen';
  205.         anzahlItems:=9;
  206.         WITH mItems[0] DO
  207.           iname:='Neue Funktion';
  208.           commandKey:='N';
  209.           anzahlSubitems:=0;
  210.         END;
  211.         WITH mItems[1] DO
  212.           iname:='Schirm löschen';
  213.           commandKey:='D';
  214.           anzahlSubitems:=0;
  215.         END;
  216.         WITH mItems[2] DO
  217.           iname:='Min&Max';
  218.           anzahlSubitems:=2;
  219.           subrecords[0].subName:='var.';
  220.           subrecords[0].commandKey:='v';
  221.           subrecords[1].subName:='const';
  222.           subrecords[1].commandKey:='c';
  223.         END;
  224.         WITH mItems[3] DO
  225.           iname:='Def.Gebiet Einschr.';
  226.           commandKey:=0C;
  227.           anzahlSubitems:=2;
  228.           subrecords[0].subName:='Nein';
  229.           subrecords[0].commandKey:='N';
  230.           subrecords[1].subName:='Ja';
  231.           subrecords[1].commandKey:='J';
  232.         END;
  233.         WITH mItems[4] DO
  234.           iname:='X-Intervalle';
  235.           commandKey:=0C;
  236.           anzahlSubitems:=2;
  237.           subrecords[0].subName:='var.';
  238.           subrecords[0].commandKey:=0C;
  239.           subrecords[1].subName:='const';
  240.           subrecords[1].commandKey:=0C;
  241.         END;
  242.         WITH mItems[5] DO
  243.           iname:='Y-Intervalle';
  244.           commandKey:=0C;
  245.           anzahlSubitems:=2;
  246.           subrecords[0].subName:='var.';
  247.           subrecords[0].commandKey:=0C;
  248.           subrecords[1].subName:='const';
  249.           subrecords[1].commandKey:=0C;
  250.         END;
  251.         WITH mItems[6] DO
  252.           iname:='Malen';
  253.           commandKey:=0C;
  254.           anzahlSubitems:=0;
  255.         END;
  256.         WITH mItems[7] DO
  257.           iname:='Funktionsstring';
  258.           commandKey:=0C;
  259.           anzahlSubitems:=0;
  260.         END;
  261.         WITH mItems[8] DO
  262.           iname:='Ins Hauptmenü';
  263.           commandKey:='E';
  264.           anzahlSubitems:=0;
  265.         END;
  266.       END;
  267.       WITH menurecords[1] DO
  268.         mname:='Parameter';
  269.         anzahlItems:=8;
  270.         WITH mItems[0] DO
  271.           iname:='Hintergrundfarbe';
  272.           anzahlSubitems:=4;
  273.           subrecords[0].subName:=' 0';
  274.           subrecords[0].commandKey:=0C;
  275.           subrecords[1].subName:=' 1';
  276.           subrecords[1].commandKey:=0C;
  277.           subrecords[2].subName:=' 2';
  278.           subrecords[2].commandKey:=0C;
  279.           subrecords[3].subName:=' 3';
  280.           subrecords[3].commandKey:=0C;
  281.         END;
  282.         WITH mItems[1] DO
  283.           iname:='Zeichenfarbe';
  284.           anzahlSubitems:=4;
  285.           subrecords[0].subName:=' 1';
  286.           subrecords[0].commandKey:=0C;
  287.           subrecords[1].subName:=' 2';
  288.           subrecords[1].commandKey:=0C;
  289.           subrecords[2].subName:=' 3';
  290.           subrecords[2].commandKey:=0C;
  291.           subrecords[3].subName:=' 0';
  292.           subrecords[3].commandKey:=0C;
  293.         END;
  294.         WITH mItems[2] DO
  295.           iname:='TextFarbe';
  296.           anzahlSubitems:=4;
  297.           subrecords[0].subName:=' 1';
  298.           subrecords[0].commandKey:=0C;
  299.           subrecords[1].subName:=' 2';
  300.           subrecords[1].commandKey:=0C;
  301.           subrecords[2].subName:=' 3';
  302.           subrecords[2].commandKey:=0C;
  303.           subrecords[3].subName:=' 0';
  304.           subrecords[3].commandKey:=0C;
  305.         END;
  306.         WITH mItems[3] DO
  307.           iname:='Auflösung';
  308.           anzahlSubitems:=4;
  309.           subrecords[0].subName:='640';
  310.           subrecords[0].commandKey:='1';
  311.           subrecords[1].subName:='320';
  312.           subrecords[1].commandKey:='2';
  313.           subrecords[2].subName:='160';
  314.           subrecords[2].commandKey:='3';
  315.           subrecords[3].subName:='80';
  316.           subrecords[3].commandKey:='4';
  317.         END;
  318.         WITH mItems[4] DO
  319.           iname:='Winkeleinheit';
  320.           anzahlSubitems:=3;
  321.           subrecords[0].subName:='Rad';
  322.           subrecords[0].commandKey:=0C;
  323.           subrecords[1].subName:='Deg';
  324.           subrecords[1].commandKey:=0C;
  325.           subrecords[2].subName:='Gon';
  326.           subrecords[2].commandKey:=0C;
  327.         END;
  328.         WITH mItems[5] DO
  329.           iname:='Gitter';
  330.           anzahlSubitems:=2;
  331.           subrecords[0].subName:='Aus';
  332.           subrecords[0].commandKey:=0C;
  333.           subrecords[1].subName:='Ein';
  334.           subrecords[1].commandKey:=0C;
  335.         END;
  336.         WITH mItems[6] DO
  337.           iname:='Rahmen';
  338.           anzahlSubitems:=2;
  339.           subrecords[0].subName:='Ja';
  340.           subrecords[0].commandKey:=0C;
  341.           subrecords[1].subName:='Nein';
  342.           subrecords[1].commandKey:=0C;
  343.         END;
  344.         WITH mItems[7] DO
  345.           iname:='Beschriftung';
  346.           anzahlSubitems:=2;
  347.           subrecords[0].subName:='Ja';
  348.           subrecords[0].commandKey:=0C;
  349.           subrecords[1].subName:='Nein';
  350.           subrecords[1].commandKey:=0C;
  351.         END;
  352.       END;
  353.       WITH menurecords[2] DO
  354.         mname:='Extern';
  355.         anzahlItems:=8;
  356.         WITH mItems[0] DO
  357.           iname:='Save';
  358.           commandKey:='S';
  359.           anzahlSubitems:=0;
  360.         END;
  361.         WITH mItems[1] DO
  362.           iname:='Load';
  363.           commandKey:='L';
  364.           anzahlSubitems:=0;
  365.         END;
  366.         WITH mItems[2] DO
  367.           iname:='Hardcopy Standart';
  368.           commandKey:='H';
  369.           anzahlSubitems:=0;
  370.         END;
  371.         WITH mItems[3] DO
  372.           iname:='Hardcopy Groß';
  373.           commandKey:='G';
  374.           anzahlSubitems:=0;
  375.         END;
  376.         WITH mItems[4] DO
  377.           iname:='Hardcopy Pref.';
  378.           commandKey:='P';
  379.           anzahlSubitems:=0;
  380.         END;
  381.         WITH mItems[5] DO
  382.           iname:='Druckdichte';
  383.           anzahlSubitems:=5;
  384.           subrecords[0].subName:=' 0';
  385.           subrecords[0].commandKey:=0C;
  386.           subrecords[1].subName:=' 1';
  387.           subrecords[1].commandKey:=0C;
  388.           subrecords[2].subName:=' 2';
  389.           subrecords[2].commandKey:=0C;
  390.           subrecords[3].subName:=' 3';
  391.           subrecords[3].commandKey:=0C;
  392.           subrecords[4].subName:=' 4';
  393.           subrecords[4].commandKey:=0C;
  394.         END;
  395.         WITH mItems[6] DO
  396.           iname:='Standartgröße x';
  397.           anzahlSubitems:=4;
  398.           subrecords[0].subName:=' 1';
  399.           subrecords[0].commandKey:=0C;
  400.           subrecords[1].subName:=' 2';
  401.           subrecords[1].commandKey:=0C;
  402.           subrecords[2].subName:=' 3';
  403.           subrecords[2].commandKey:=0C;
  404.           subrecords[3].subName:=' 4';
  405.           subrecords[3].commandKey:=0C;
  406.         END;
  407.         WITH mItems[7] DO
  408.           iname:='Standartgröße y';
  409.           anzahlSubitems:=4;
  410.           subrecords[0].subName:=' 1';
  411.           subrecords[0].commandKey:=0C;
  412.           subrecords[1].subName:=' 2';
  413.           subrecords[1].commandKey:=0C;
  414.           subrecords[2].subName:=' 3';
  415.           subrecords[2].commandKey:=0C;
  416.           subrecords[3].subName:=' 4';
  417.           subrecords[3].commandKey:=0C;
  418.         END; 
  419.       END;
  420.       WITH menurecords[3] DO
  421.         mname:='Window';
  422.         anzahlItems:=2;
  423.         WITH mItems[0] DO
  424.           iname:='Nach Hinten';
  425.           commandKey:='B';
  426.           anzahlSubitems:=0;
  427.         END;
  428.         WITH mItems[1]DO
  429.           iname:='Nach Vorn';
  430.           commandKey:='F';
  431.           anzahlSubitems:=0;
  432.         END;
  433.       END;
  434.       InitMenu(menurecords,firstMenu,rememberkey);
  435.     END InitGraphicmenu;
  436. (*************************************************************************)
  437.     PROCEDURE ClearScreen;
  438.           TYPE XY=RECORD
  439.                     x:INTEGER;
  440.                     y:INTEGER
  441.                   END;
  442.           VAR oldAPen:CARDINAL;
  443.             borko:ARRAY[0..4] OF XY;
  444.             frame:Border;
  445.         BEGIN
  446.           oldAPen:=wPtr^.rPort^.fgPen;
  447.           SetAPen(wPtr^.rPort,backgroundColor);
  448.           RectFill(wPtr^.rPort,0,0,MaxHorzRes-1,maxVertRes-1);
  449.           IF rahmen THEN
  450.             borko[0].x:=0;
  451.             borko[0].y:=0;
  452.             borko[1].x:=MaxHorzRes-1;
  453.             borko[1].y:=0;
  454.             borko[2].x:=MaxHorzRes-1;
  455.             borko[2].y:=maxVertRes-1;
  456.             borko[3].x:=0;
  457.             borko[3].y:=maxVertRes-1;
  458.             borko[4].x:=0;
  459.             borko[4].y:=0;
  460.             WITH frame DO
  461.               leftEdge:=0;
  462.               topEdge:=0;
  463.               frontPen:=textColor;
  464.               backPen:=backgroundColor;
  465.               drawMode:=jam1;
  466.               count:=5;
  467.               xy:=ADR(borko[0].x);
  468.               nextBorder:=NIL
  469.             END;
  470.             DrawBorder(wPtr^.rPort,ADR(frame),0,0)
  471.           END;
  472.           SetAPen(wPtr^.rPort,oldAPen);
  473.           IF minMaxDef THEN
  474.             min:=newMin;
  475.             max:=newMax;
  476.             minMaxFest:=TRUE
  477.           ELSE
  478.             minMaxFest:=FALSE
  479.           END;
  480.           firstTime:=TRUE;
  481.         END ClearScreen;
  482. (*************************************************************************)
  483.     PROCEDURE RespondMessage;
  484.       VAR
  485.         class:IDCMPFlagSet;
  486.         code:CARDINAL;
  487.         msgPtr:IntuiMessagePtr;
  488.       PROCEDURE MenuReaction;
  489.         VAR
  490.           menuNr,itemNr,subNr:CARDINAL;
  491.           menuIPtr:MenuItemPtr;
  492.         PROCEDURE DatenEinlesen():BOOLEAN;
  493.           VAR fN:CARDINAL;
  494.             windowTitel:Buffer;
  495.             error:(noError,cancel,intervall,laufvariable);
  496.         BEGIN
  497.           fN:=1; (* muss # 0 sein *)
  498.           error:=noError;
  499.           windowTitel:='Werte eingeben und OK anklicken !';
  500.           REPEAT
  501.             IF firstTime THEN
  502.               IF AskForStrings(windowTitel,4,eingaben) THEN
  503.                 IF GetLaufvariable(eingaben[1].buffer) THEN
  504.                   IF GetIntervall(eingaben[2].buffer,eingaben[3].buffer,
  505.                                   startw,endw) THEN
  506.                     fN:=GetFormel(2,eingaben[0].buffer);
  507.                   ELSE
  508.                     error:=intervall
  509.                   END;
  510.                 ELSE
  511.                  error:=laufvariable;
  512.                 END;
  513.               ELSE
  514.                 error:=cancel
  515.               END
  516.             ELSE
  517.               IF AskForStrings(windowTitel,2,eingaben) THEN
  518.                 IF GetLaufvariable(eingaben[1].buffer) THEN
  519.                   fN:=GetFormel(2,eingaben[0].buffer);
  520.                 ELSE
  521.                   error:=laufvariable
  522.                 END
  523.               ELSE
  524.                 error:=cancel
  525.               END
  526.             END;
  527.             IF error=laufvariable THEN 
  528.               windowTitel:= 'Laufvariable ungültig'
  529.             ELSIF error =intervall THEN
  530.               windowTitel:=('Grenzen ungueltig')
  531.             ELSIF fN#0 THEN 
  532.               GetFehlertext(fN,windowTitel);
  533.             END;
  534.           UNTIL (fN=0) OR (error=cancel);
  535.           ClearVar(eingaben[1].buffer[0]);
  536.           RETURN error#cancel;
  537.         END DatenEinlesen;
  538. (*************************************************************************)
  539.         PROCEDURE WerteBerechnen;
  540.           VAR
  541.             j,h:[-1..MaxHorzRes];
  542.             x,increment:FFP;
  543.             oK:BOOLEAN;
  544.             c:CHAR;
  545.         BEGIN
  546.           c:=eingaben[1].buffer[0];
  547.           x:=startw;
  548.           increment:=FFP(raster);
  549.           increment:=(endw-startw)/FFP(horzRes)*increment;
  550.           j:=0;
  551.           h:=horzRes-1;
  552.           WHILE j < h DO
  553.             bildspeicher[j].xWert:=x;
  554.             IF NOT defAreaSet OR ((x>=def1) AND (x<=def2)) THEN
  555.               (*oK:=AssignFFP(c,x);*)
  556.               varListFFP[c]:=x;
  557.               FFPBerechnung(2,bildspeicher[j].wert,bildspeicher[j].fN)
  558.             ELSE
  559.               bildspeicher[j].fN:=OutOfDefArea
  560.             END;
  561.             x:=x+increment;
  562.             INC(j,raster);
  563.           END;
  564.           bildspeicher[h].xWert:=endw;
  565.           IF NOT defAreaSet OR ((endw>=def1) AND (endw<=def2)) THEN
  566.             oK:=AssignFFP(c,endw);
  567.             FFPBerechnung(2,bildspeicher[h].wert,bildspeicher[h].fN)
  568.           ELSE
  569.             bildspeicher[h].fN:=OutOfDefArea
  570.           END;
  571.           ClearVar(c);
  572.         END WerteBerechnen;
  573. (*************************************************************************)
  574.         PROCEDURE MinMaxBestimmen():BOOLEAN;
  575.           VAR i,h:[-1..MaxHorzRes];
  576.         BEGIN
  577.           h:=horzRes-1;
  578.           i:=0;
  579.           WHILE (bildspeicher[i].fN # 0) AND (i< horzRes) DO 
  580.             INC(i,raster);
  581.           END;
  582.           IF i< horzRes THEN 
  583.             min:=bildspeicher[i].wert;
  584.             max:= bildspeicher[i].wert;
  585.             INC(i,raster);
  586.             WHILE i<h DO
  587.               IF bildspeicher[i].fN=0 THEN
  588.                 IF bildspeicher[i].wert > max THEN
  589.                   max:=bildspeicher[i].wert
  590.                 ELSIF bildspeicher[i].wert < min THEN
  591.                   min:= bildspeicher[i].wert 
  592.                 END
  593.               END;
  594.               INC(i,raster);
  595.             END;
  596.             IF bildspeicher[h].fN=0 THEN
  597.               IF bildspeicher[h].wert > max THEN
  598.                 max:=bildspeicher[h].wert
  599.               ELSIF bildspeicher[h].wert < min THEN
  600.                 min:= bildspeicher[h].wert 
  601.               END
  602.             END;
  603.             IF min = max THEN
  604.               min:=min-1.0;
  605.               max:=max+1.0;
  606.             END;
  607.             RETURN TRUE
  608.           ELSE
  609.             RETURN FALSE;
  610.           END;
  611.         END MinMaxBestimmen;
  612. (*************************************************************************)
  613.         PROCEDURE Verschiebung;
  614.         BEGIN
  615.           IF endw<=0.0 THEN
  616.             horzVersch:=zwei
  617.           ELSE
  618.             horzVersch:=Zahlenstellen*charWidth+zwei
  619.           END;
  620.           IF max<=0.0 THEN
  621.             vertVersch:=charHeight+zwei
  622.           ELSE
  623.             vertVersch:=zwei
  624.           END;
  625.         END Verschiebung;
  626. (*************************************************************************)
  627.         PROCEDURE Text;
  628.           TYPE ex=(ma,mi,sw,ew);
  629.           VAR i:ex;
  630.             l:INTEGER;
  631.             left:BOOLEAN;
  632.             beschriftung:ARRAY[ma..ew] OF RECORD
  633.                                             w:ARRAY[0..Zahlenstellen] OF CHAR;
  634.                                             x,y:INTEGER;
  635.                                           END;
  636.             myText:IntuiText;
  637.             error:BOOLEAN;
  638.         BEGIN
  639.           left:=endw<=0.0;
  640.           FFPToStr(max,beschriftung[ma].w,left);
  641.           FFPToStr(min,beschriftung[mi].w,left);
  642.           FFPToStr(startw,beschriftung[sw].w,TRUE);
  643.           FFPToStr(endw,beschriftung[ew].w,FALSE);
  644.           IF endw <=0.0  THEN
  645.             beschriftung[ma].x:=xLinePos+1;
  646.           ELSE
  647.             beschriftung[ma].x:=xLinePos-charWidth*Zahlenstellen-1;
  648.           END;
  649.           beschriftung[mi].x:=beschriftung[ma].x;
  650.           IF max>0.0 THEN
  651.             beschriftung[ma].y:=vertVersch
  652.           ELSE
  653.             beschriftung[ma].y:=vertVersch+2;
  654.           END;
  655.           IF min>=0.0 THEN
  656.             beschriftung[mi].y:=vertRes-1+vertVersch-charHeight
  657.           ELSE
  658.             beschriftung[mi].y:=vertRes-1+vertVersch-charHeight+zwei
  659.           END;
  660.           IF max <= 0.0 THEN
  661.             beschriftung[sw].y:= yLinePos-charHeight;
  662.           ELSE
  663.             beschriftung[sw].y:=yLinePos+2;
  664.           END;
  665.           beschriftung[ew].y:=beschriftung[sw].y;
  666.           beschriftung[sw].x:=horzVersch;
  667.           beschriftung[ew].x:=horzVersch+horzRes-1-Zahlenstellen*charWidth;
  668.           FOR i:= ma TO ew DO
  669.             WITH myText DO
  670.               frontPen:=textColor;
  671.               backPen:=backgroundColor;
  672.               drawMode:=jam1;
  673.               leftEdge:=0;
  674.               topEdge:=0;
  675.               iTextFont:=NIL;
  676.               iText:=ADR(beschriftung[i].w);
  677.               nextText:=NIL;
  678.             END;
  679.             PrintIText(wPtr^.rPort,ADR(myText),beschriftung[i].x,
  680.                        beschriftung[i].y);
  681.           END;
  682.         END Text;
  683. (*************************************************************************)
  684.         PROCEDURE Stauchen;
  685.           VAR i,h:[-1..MaxHorzRes];
  686.             faktor:FFP;
  687.             help:FFP;
  688.         BEGIN
  689.           h:=horzRes-1;
  690.           faktor:=(ffpVertRes-1.0)/(max-min);
  691.           i:=0;
  692.           WHILE i<h DO
  693.             IF bildspeicher[i].fN=0 THEN
  694.               help:=(bildspeicher[i].wert-min)*faktor;
  695.               IF (help>=0.0) AND (help<ffpVertRes) THEN
  696.                 bildspeicher[i].intWert:=INTEGER(help+0.5)
  697.               ELSE
  698.                 bildspeicher[i].fN:=OutOfRange
  699.               END
  700.             END;
  701.             INC(i,raster)
  702.           END;
  703.           IF bildspeicher[h].fN=0 THEN
  704.             help:=(bildspeicher[h].wert-min)*faktor;
  705.             IF (help>=0.0) AND (help<ffpVertRes) THEN
  706.                 bildspeicher[h].intWert:=INTEGER(help+0.5)
  707.               ELSE
  708.                 bildspeicher[h].fN:=OutOfRange
  709.               END
  710.           END;
  711.         END Stauchen;
  712. (*************************************************************************)
  713.         PROCEDURE ZeichneFktn;
  714.           VAR
  715.             position,v:[-1..512];(* Start at -1 to be an INTEGER *)
  716.             jjj,h:[-1..MaxHorzRes];
  717.           PROCEDURE WriteErrors;
  718.             CONST Zeilen=20;
  719.             VAR
  720.               w:WindowPtr;
  721.               msgPtr:IntuiMessagePtr;
  722.               text:ARRAY[0..50] OF CHAR;
  723.               str:ARRAY[0..20] OF CHAR;
  724.               i,h:[-1..MaxHorzRes];
  725.               closeIt:BOOLEAN;
  726.           BEGIN
  727.             i:=0;
  728.             h:=horzRes-1;
  729.             closeIt:=FALSE;
  730.             WHILE  (i<=h) AND ((bildspeicher[i].fN=0) OR
  731.                    (bildspeicher[i].fN=OutOfDefArea)) DO
  732.               INC(i,raster)
  733.             END;
  734.             IF i<=h THEN
  735.               OpenNewWindow(w,0,0,58,Zeilen,FlagSet{drag,close,depth},
  736.                             'An diesen Stellen traten Fehler auf');
  737.               WriteString(w,'Laufvariable | Fehler',TRUE);
  738.      WriteString(w,'----------------------------------------------------------',
  739.               TRUE);
  740.               Delay(30);
  741.               WHILE (NOT closeIt) AND (i<=h) DO
  742.                 IF (bildspeicher[i].fN#0) AND
  743.                    (bildspeicher[i].fN#OutOfDefArea) THEN
  744.                   IF ABS(bildspeicher[i].xWert)>1.0 THEN
  745.                     RealToStr(bildspeicher[i].xWert,str,6,6)
  746.                   ELSE
  747.                     RealToStr(bildspeicher[i].xWert,str,6,-6)
  748.                   END;
  749.                   GetFehlertext(bildspeicher[i].fN,text);
  750.                   WriteString(w,str,FALSE);
  751.                   WriteString(w,' | ',FALSE);
  752.                   WriteString(w,text,TRUE);
  753.                   msgPtr := GetMsg (w^.userPort);
  754.                   IF msgPtr#NIL THEN
  755.                     ReplyMsg (msgPtr);
  756.                     closeIt:=TRUE
  757.                   END
  758.                 END;
  759.                 INC(i,raster)
  760.               END;
  761.               IF NOT closeIt THEN
  762.                 WaitPort(w^.userPort)
  763.               END;
  764.               msgPtr := GetMsg (w^.userPort);
  765.               IF msgPtr#NIL THEN
  766.                 ReplyMsg (msgPtr)
  767.               END;
  768.               CloseNewWindow(w);
  769.             END;
  770.           END WriteErrors;
  771.               
  772.         BEGIN
  773.           h:=horzRes-1;
  774.           v:=vertRes-1;
  775.           SetBPen(wPtr^.rPort,backgroundColor);
  776.           SetAPen(wPtr^.rPort,drawingColor);
  777.           SetDrMd(wPtr^.rPort,jam1);
  778.           jjj:=0;
  779.           REPEAT
  780.             IF bildspeicher[jjj].fN=0 THEN
  781.               position:=(v-bildspeicher[jjj].intWert);
  782.               Move(wPtr^.rPort,jjj+horzVersch,position+vertVersch)
  783.             END;
  784.             INC(jjj,raster);
  785.           UNTIL (bildspeicher[jjj].fN=0) OR (jjj>=h);
  786.           WHILE jjj< h DO
  787.             IF (bildspeicher[jjj].fN=0) AND (bildspeicher[jjj-raster].fN=0) THEN
  788.               position:=(v-bildspeicher[jjj].intWert);
  789.               Draw(wPtr^.rPort,jjj+horzVersch,position+vertVersch)
  790.             ELSIF bildspeicher[jjj].fN=0 THEN
  791.               position:=(v-bildspeicher[jjj].intWert);
  792.               Move(wPtr^.rPort,jjj+horzVersch,position+vertVersch)
  793.             END;
  794.             INC(jjj,raster);
  795.           END;
  796.           IF (bildspeicher[h].fN=0) AND
  797.              (bildspeicher[jjj-raster].fN=0) THEN
  798.             position:=(v-bildspeicher[h].intWert);
  799.             Draw(wPtr^.rPort,h+horzVersch,position+vertVersch);
  800.           END;
  801.           WriteErrors;
  802.         END ZeichneFktn;
  803. (*************************************************************************)
  804.         PROCEDURE DrawLines;
  805.         BEGIN
  806.           SetBPen(wPtr^.rPort,backgroundColor);
  807.           SetAPen(wPtr^.rPort,textColor);
  808.           SetDrMd(wPtr^.rPort,jam1);
  809.           IF max <= 0.0 THEN
  810.             yLinePos:=0
  811.           ELSIF
  812.             min >=0.0 THEN yLinePos:=vertRes-1 
  813.           ELSE
  814.             yLinePos:=INTEGER(max/(max-min)*(ffpVertRes-1.0)+0.5);
  815.           END;
  816.           yLinePos:=yLinePos+vertVersch;
  817.           Move(wPtr^.rPort,horzVersch,yLinePos);
  818.           Draw(wPtr^.rPort,horzVersch+horzRes-1,yLinePos);
  819.           IF startw >= 0.0 THEN
  820.             xLinePos:=0 
  821.           ELSIF
  822.             endw <=0.0 THEN xLinePos:=horzRes-1
  823.           ELSE
  824.           xLinePos:=INTEGER(startw/(startw-endw)*(FFP(horzRes-1))+0.5);
  825.           END;
  826.           xLinePos:=xLinePos+horzVersch;
  827.           Move(wPtr^.rPort,xLinePos,vertVersch);
  828.           Draw(wPtr^.rPort,xLinePos,vertRes-1+vertVersch);
  829.         END DrawLines;
  830. (*************************************************************************)
  831.         PROCEDURE Striche;
  832.           CONST
  833.             Epsilon1=0.1;
  834.             Epsilon2=1.001E-2;
  835.           VAR
  836.             x,xStep,xPos:FFP;
  837.             y,yStep,yPos:FFP;
  838.             ixPos,iyPos,pos1,pos2:INTEGER;
  839.             dx:FFP;(*Anzahl der Intervalle*)
  840.             dy:FFP;
  841.             dividiert:BOOLEAN;
  842.             i:INTEGER;
  843.         BEGIN
  844.           SetBPen(wPtr^.rPort,backgroundColor);
  845.           IF gitter THEN
  846.             SetAPen(wPtr^.rPort,drawingColor)
  847.           ELSE
  848.             SetAPen(wPtr^.rPort,textColor)
  849.           END;
  850.           SetDrMd(wPtr^.rPort,jam1);
  851.           IF xUnterteilung#255 THEN
  852.             dx:=FFP(xUnterteilung)
  853.           ELSE
  854.             IF ((endw>=0.0) AND (startw>=0.0)) OR ((endw<=0.0) AND (startw<= 0.0)) THEN
  855.               dx:=endw-startw
  856.             ELSIF
  857.               (-startw-endw) >= 0.0 
  858.               (*(ABS(startw)> ABS(endw))   Compilerfehler*) THEN dx:=-startw
  859.             ELSE
  860.               dx:=endw
  861.             END;
  862.             WHILE dx>80.0 DO
  863.               dx:=dx*1.0E-1 
  864.             END;
  865.             WHILE dx>20.0 DO (* 20< dx <80 ; teile dx, so das dx ganze Zahl *)
  866.               i:=2;dividiert:=FALSE;
  867.               REPEAT
  868.                 x:=dx/FFP(i);
  869.                 IF (ABS(x-FFP(INTEGER(x+0.5))) < Epsilon1) THEN 
  870.                   dx:=x; dividiert:=TRUE;
  871.                 END;
  872.                 INC(i);
  873.               UNTIL dividiert OR (i=20);
  874.               IF NOT dividiert THEN
  875.                 dx:=dx*0.5
  876.               END;
  877.             END;
  878.             WHILE dx<2.0 DO
  879.               dx:=dx*10.0
  880.             END;
  881.             WHILE dx<8.0 DO
  882.               dx:=dx*2.0
  883.             END;
  884.             IF ABS(dx-FFP(CARDINAL(dx+0.5))) >= Epsilon2 THEN
  885.               dx:=10.0
  886.             END;
  887.           END;
  888.           IF yUnterteilung#255 THEN
  889.             dy:=FFP(yUnterteilung)
  890.           ELSE
  891.             IF ((max>=0.0) AND (min>=0.0)) OR ((max<=0.0) AND (min<= 0.0)) THEN
  892.               dy:=max-min
  893.             ELSIF
  894.               (-min-max) >= 0.0 
  895.               (*(ABS(min)> ABS(max))   Compilerfehler*) THEN dy:=-min
  896.             ELSE
  897.               dy:=max
  898.             END;
  899.             WHILE dy>80.0 DO
  900.             dy:=dy*1.0E-1 
  901.             END; 
  902.             WHILE dy>20.0 DO
  903.               i:=2;dividiert:=FALSE;
  904.               REPEAT
  905.                 y:=dy/FFP(i);
  906.                 IF (ABS(y-FFP(INTEGER(y+0.5))) < Epsilon1) THEN 
  907.                   dy:=y; dividiert:=TRUE;
  908.                 END;
  909.                 INC(i);
  910.               UNTIL dividiert OR (i=20);
  911.               IF NOT dividiert THEN
  912.                 dy:=dy*0.5
  913.               END;
  914.             END; 
  915.             WHILE dy<2.0 DO
  916.              dy:=dy*10.0
  917.             END;
  918.             WHILE dy<8.0 DO
  919.               dy:=dy*2.0
  920.             END;
  921.             IF ABS(dy-FFP(CARDINAL(dy+0.5))) >= Epsilon2 THEN
  922.               dy:=10.0
  923.             END;
  924.           END;
  925.           IF xUnterteilung#0 THEN
  926.             IF (xLinePos-horzVersch) >= (horzRes DIV 2) THEN
  927.               dx:=FFP(INTEGER(dx+0.5));
  928.               xStep:=(FFP(xLinePos-horzVersch))/dx
  929.             ELSE
  930.               dx:=FFP(INTEGER(dx+0.5));
  931.               xStep:=(FFP(horzRes-1+horzVersch-xLinePos)/dx)
  932.             END;
  933.           END;
  934.           IF yUnterteilung#0 THEN
  935.             IF (yLinePos-vertVersch) >= (vertRes DIV 2) THEN
  936.               dy:=FFP(INTEGER(dy+0.5));
  937.               yStep:=(FFP(yLinePos-vertVersch)/dy)
  938.             ELSE
  939.               dy:=FFP(INTEGER(dy+0.5));
  940.               yStep:=(FFP(vertRes-1+vertVersch-yLinePos)/dy)
  941.             END;
  942.           END;
  943.           IF xUnterteilung#0 THEN
  944.             IF gitter THEN
  945.               pos1:=vertVersch;
  946.               pos2:=vertRes-1+vertVersch
  947.             ELSE
  948.               pos1:=yLinePos-1;
  949.               pos2:=yLinePos+1
  950.             END;
  951.             xPos:=FFP(xLinePos-horzVersch)+xStep;
  952.             WHILE (INTEGER(xPos+0.5) <= horzRes) DO
  953.               ixPos:=INTEGER(xPos+0.5)+horzVersch;
  954.               IF (ixPos=horzRes+horzVersch) THEN DEC(ixPos) END;
  955.               Move(wPtr^.rPort,ixPos,pos1);
  956.               Draw(wPtr^.rPort,ixPos,pos2);
  957.               xPos:=xPos+xStep;
  958.             END;
  959.             xPos:=FFP(xLinePos-horzVersch)-xStep;
  960.             WHILE (INTEGER(xPos+0.5) >= -1) DO
  961.               ixPos:=INTEGER(xPos+0.5)+horzVersch;
  962.               IF (ixPos=horzVersch-1) THEN INC(ixPos) END;
  963.               Move(wPtr^.rPort,ixPos,pos1);
  964.               Draw(wPtr^.rPort,ixPos,pos2);
  965.               xPos:=xPos-xStep;
  966.             END;
  967.           END;
  968.           IF yUnterteilung#0 THEN
  969.             IF gitter THEN
  970.               pos1:=horzVersch;
  971.               pos2:=horzRes-1+horzVersch
  972.             ELSE
  973.               pos1:=xLinePos-1;
  974.               pos2:=xLinePos+1
  975.             END;
  976.             yPos:=FFP(yLinePos-vertVersch)+yStep;
  977.             WHILE (INTEGER(yPos+0.5) <= vertRes) DO
  978.               iyPos:=INTEGER(yPos+0.5)+vertVersch;
  979.               IF (iyPos=vertRes+vertVersch) THEN DEC(iyPos) END;
  980.               Move(wPtr^.rPort,pos1,iyPos);
  981.               Draw(wPtr^.rPort,pos2,iyPos);
  982.               yPos:=yPos+yStep;
  983.             END;
  984.             yPos:=FFP(yLinePos-vertVersch)-yStep;
  985.             WHILE (INTEGER(yPos+0.5) >= -1) DO
  986.               iyPos:=INTEGER(yPos+0.5)+vertVersch;
  987.               IF (iyPos=vertVersch-1) THEN INC(iyPos) END;
  988.               Move(wPtr^.rPort,pos1,iyPos);
  989.               Draw(wPtr^.rPort,pos2,iyPos);
  990.               yPos:=yPos-yStep;
  991.             END;
  992.           END;
  993.         END Striche;
  994. (*************************************************************************)
  995.         PROCEDURE NewFunction;
  996.         BEGIN
  997.           IF DatenEinlesen() THEN
  998.             WerteBerechnen;
  999.             IF firstTime  THEN
  1000.               IF (minMaxFest OR MinMaxBestimmen()) THEN
  1001.                 Stauchen;
  1002.                 Verschiebung;
  1003.                 DrawLines;
  1004.                 Striche;
  1005.                 ZeichneFktn;
  1006.                 IF beschriftung THEN
  1007.                   Text
  1008.                 END;
  1009.                 firstTime:=FALSE
  1010.               ELSE
  1011.                 DisplayBeep(wPtr^.wScreen)
  1012.               END
  1013.             ELSE
  1014.               Stauchen;    
  1015.               ZeichneFktn;
  1016.             END
  1017.           END;
  1018.         END NewFunction;
  1019. (*************************************************************************)
  1020.         PROCEDURE DefAreaMinMax(i:TypA);
  1021.           VAR wPtr:WindowPtr;
  1022.             fN:CARDINAL;
  1023.             x1,x2:FFP;
  1024.             s:Formelstring;
  1025.             fText:ARRAY[0..80] OF CHAR;
  1026.         BEGIN
  1027.           IF (i=mmDef) OR (i=defDef) THEN
  1028.             IF i=defDef THEN
  1029.               OpenNewWindow(wPtr,50,50,40,6,FlagSet{drag},
  1030.                           'Definitionsgebiet einschränken')
  1031.             ELSE
  1032.               OpenNewWindow(wPtr,50,50,40,6,FlagSet{drag},
  1033.                           'Minimum und Maximum festlegen')
  1034.             END;
  1035.             REPEAT
  1036.               IF i=defDef THEN
  1037.                 ReadString(wPtr,'Untere Grenze: ',s,25)
  1038.               ELSE
  1039.                 ReadString(wPtr,'Minimum: ',s,30)
  1040.               END;
  1041.               IF s[0]#0C THEN
  1042.                 IF DefFormel(9,s,TRUE,onlyLong)=0 THEN
  1043.                   FFPBerechnung(9,x1,fN)
  1044.                 END;
  1045.                 IF fN#0 THEN
  1046.                   GetFehlertext(fN,fText);
  1047.                   WriteString(wPtr,fText,TRUE);
  1048.                 END;
  1049.               END;
  1050.             UNTIL (fN=0) OR (s[0]=0C);
  1051.             IF s[0]#0C THEN
  1052.               REPEAT
  1053.                 IF i=defDef THEN
  1054.                   ReadString(wPtr,'Obere Grenze:  ',s,25)
  1055.                 ELSE
  1056.                   ReadString(wPtr,'Maximum: ',s,30)
  1057.                 END;
  1058.                 IF s[0]#0C THEN
  1059.                   IF DefFormel(9,s,TRUE,onlyLong)=0 THEN
  1060.                     FFPBerechnung(9,x2,fN);
  1061.                   END;
  1062.                   IF fN#0 THEN
  1063.                     GetFehlertext(fN,fText);
  1064.                     WriteString(wPtr,fText,TRUE)
  1065.                   END;
  1066.                   IF x2<=x1 THEN
  1067.                     IF i=defDef THEN
  1068.                       WriteString(wPtr,'Obere Gr. muß größer als untere sein',
  1069.                                 TRUE)
  1070.                     ELSE
  1071.                       WriteString(wPtr,'Maximum muß größer als Mimimum sein',
  1072.                                 TRUE)
  1073.                     END
  1074.                   END
  1075.                 END;
  1076.               UNTIL ((fN=0) AND (x1<x2)) OR (s[0]=0C);
  1077.             END;
  1078.             CloseNewWindow(wPtr);
  1079.             IF s[0]#0C THEN
  1080.               IF i=defDef THEN
  1081.                 def1:=x1;
  1082.                 def2:=x2;
  1083.                 defAreaSet:=TRUE;
  1084.               ELSE
  1085.                 IF firstTime THEN
  1086.                   minMaxFest:=TRUE;
  1087.                   min:=x1;
  1088.                   max:=x2
  1089.                 END;
  1090.                 newMin:=x1;
  1091.                 newMax:=x2;
  1092.                 minMaxDef:=TRUE
  1093.               END
  1094.             END
  1095.           ELSE 
  1096.             IF i=defVar THEN
  1097.               defAreaSet:=FALSE
  1098.             ELSE
  1099.               minMaxDef:=FALSE
  1100.             END
  1101.           END;
  1102.         END DefAreaMinMax;
  1103. (*************************************************************************)
  1104.         PROCEDURE DrawingColor(n:CARDINAL);
  1105.         BEGIN
  1106.           SetAPen(wPtr^.rPort,n);
  1107.         END DrawingColor;
  1108. (*************************************************************************)
  1109.         PROCEDURE Drawing;
  1110.           VAR
  1111.             xyWPtr:WindowPtr;
  1112.             ffpPos,deltaX,deltaY:FFP;
  1113.             str:ARRAY[0..Zahlenstellen] OF CHAR;
  1114.             error:BOOLEAN;
  1115.             msgPtr:IntuiMessagePtr;
  1116.             class,oldIDCMP:IDCMPFlagSet;
  1117.             code:CARDINAL;
  1118.             xPos,yPos,oldX,oldY,hh1,hh2,hh3:INTEGER;
  1119.             buttonDown:BOOLEAN;
  1120.             pointer:ARRAY[0..21] OF CARDINAL;
  1121.             pDates:ADDRESS;
  1122.             i:[0..21];
  1123.         BEGIN
  1124.           FOR i:=0 TO 21 DO
  1125.             IF ODD(i) THEN
  1126.               pointer[i]:=0
  1127.             ELSE
  1128.               pointer[i]:=256
  1129.             END
  1130.           END;
  1131.           pointer[0]:=0;
  1132.           pointer[10]:=7920;
  1133.           pointer[20]:=0;
  1134.           IF (ADR(pointer[0])+SIZE(pointer))>=07FFFFH THEN
  1135.             pDates:=AllocMem(SIZE(pointer),MemReqSet{chip});
  1136.             CopyMem(ADR(pointer),pDates,SIZE(pointer));
  1137.             SetPointer(wPtr,pDates,9,16,-8,-4);
  1138.           ELSE
  1139.             SetPointer(wPtr,ADR(pointer),9,16,-8,-4)
  1140.           END;
  1141.           oldIDCMP:=wPtr^.idcmpFlags;
  1142.           ModifyIDCMP(wPtr,IDCMPFlagSet{mouseMove,mouseButtons,menuPick,
  1143.                                         intuiTicks});
  1144.           SetBPen(wPtr^.rPort,backgroundColor);
  1145.           SetDrMd(wPtr^.rPort,jam1);
  1146.           SetAPen(wPtr^.rPort,drawingColor);
  1147.           deltaX:=(endw-startw)/FFP(horzRes-1);
  1148.           deltaY:=(max-min)/FFP(vertRes-1);
  1149.           hh1:=horzVersch+horzRes-1;
  1150.           hh2:=vertVersch+vertRes-1;
  1151.           hh3:=vertRes-1+vertVersch;
  1152.           buttonDown:=FALSE;
  1153.           OpenNewWindow(xyWPtr,0,50,11,4,FlagSet{drag,depth},'XY');
  1154.           ActivateWindow(wPtr);
  1155.           LOOP
  1156.             WaitPort(wPtr^.userPort);
  1157.             msgPtr:=IntuiMessagePtr(REG(0));
  1158.             (* Waitport liefert im Original einen Pointer auf die erste
  1159.                IntuiMessage in userPort des Windows. Da das Modula-Waitport
  1160.                mir diesen Pointer nicht gibt, hole ich ihn mir eben aus
  1161.                D0, wo Waitport ihn ablegt. Vorher hatte ich auf das Feld
  1162.                messageKey in der Windowstruktur zugegriffen, um diesen
  1163.                Pointer zu bekommen, dieser war aber nicht immer identisch mit
  1164.                dem Pointer, den GetMsg liefert. Warum ???
  1165.             *)
  1166.             IF menuPick IN msgPtr^.class THEN
  1167.               EXIT
  1168.             ELSE
  1169.               msgPtr:=GetMsg(wPtr^.userPort);
  1170.               IF msgPtr#NIL THEN
  1171.                 class:=msgPtr^.class;
  1172.                 code:=msgPtr^.code;
  1173.                 xPos:=msgPtr^.mouseX;
  1174.                 yPos:=msgPtr^.mouseY;
  1175.                 ReplyMsg(msgPtr);
  1176.                 IF intuiTicks IN class THEN
  1177.                   IF (xPos#oldX) OR (yPos#oldY) THEN
  1178.                     oldX:=xPos;
  1179.                     oldY:=yPos;
  1180.                     ClearWindow(xyWPtr);
  1181.                     ValToStr(LONGINT(xPos),FALSE,str,10,3,' ',error);
  1182.                     WriteString(xyWPtr,'h: ',FALSE);
  1183.                     WriteString(xyWPtr,str,TRUE);
  1184.                     ValToStr(LONGINT(yPos),FALSE,str,10,3,' ',error);
  1185.                     WriteString(xyWPtr,'v: ',FALSE);
  1186.                     WriteString(xyWPtr,str,TRUE);
  1187.                     IF NOT firstTime AND (xPos>=horzVersch) AND (xPos<=hh1) THEN
  1188.                       ffpPos:=deltaX*FFP(xPos-horzVersch)+startw;
  1189.                       FFPToStr(ffpPos,str,TRUE);
  1190.                       WriteString(xyWPtr,'x:',FALSE);
  1191.                       WriteString(xyWPtr,str,TRUE)
  1192.                     ELSE
  1193.                       WriteString(xyWPtr,'',TRUE)
  1194.                     END;
  1195.                     IF NOT firstTime AND (yPos>=vertVersch) AND (yPos<=hh2) THEN
  1196.                       ffpPos:=deltaY*FFP(hh3-yPos)+min;
  1197.                       FFPToStr(ffpPos,str,TRUE);
  1198.                       WriteString(xyWPtr,'y:',FALSE);
  1199.                       WriteString(xyWPtr,str,TRUE)
  1200.                     END
  1201.                   END
  1202.                 ELSIF code=selectDown THEN
  1203.                   ReportMouse(wPtr,TRUE);
  1204.                   Move(wPtr^.rPort,xPos,yPos);
  1205.                   buttonDown:=TRUE
  1206.                 ELSIF code=selectUp THEN
  1207.                   ReportMouse(wPtr,FALSE);
  1208.                   buttonDown:=FALSE
  1209.                 END;
  1210.                 IF buttonDown THEN
  1211.                   Draw(wPtr^.rPort,xPos,yPos);
  1212.                 END
  1213.               END
  1214.             END
  1215.           END;
  1216.           CloseNewWindow(xyWPtr);
  1217.           ReportMouse(wPtr,FALSE);
  1218.           ModifyIDCMP(wPtr,oldIDCMP);
  1219.           ClearPointer(wPtr);
  1220.         END Drawing;
  1221. (*************************************************************************)
  1222.         PROCEDURE Hardcopy(c:CHAR);
  1223.         VAR
  1224.           sSet:SpecialSet;
  1225.         BEGIN
  1226.           IF c='s' THEN
  1227.             DumpRPort(wPtr^.rPort,ADR(wPtr^.wScreen^.viewPort),
  1228.                       0,0,MaxHorzRes,maxVertRes,
  1229.                       MaxHorzRes*standartXSize,
  1230.                       maxVertRes*INTEGER(standartYSize),
  1231.                       density,TRUE,TRUE);
  1232.           ELSIF c='g' THEN
  1233.             sSet:=density+ SpecialSet{milCols,milRows,aspect};
  1234.             DumpRPort(wPtr^.rPort,ADR(wPtr^.wScreen^.viewPort),
  1235.                       0,0,MaxHorzRes,maxVertRes,8000,8000,
  1236.                       sSet,TRUE,TRUE);
  1237.           ELSE(* c='p'*)
  1238.             sSet:=density+SpecialSet{fullCols,fullRows,aspect};
  1239.             DumpRPort(wPtr^.rPort,ADR(wPtr^.wScreen^.viewPort),
  1240.                       0,0,MaxHorzRes,maxVertRes,0,0,
  1241.                       sSet,TRUE,TRUE)
  1242.           END
  1243.         END Hardcopy;
  1244.  
  1245. (*************************************************************************)
  1246.         PROCEDURE XYIntervall(i:TypB);
  1247.         VAR wPtr:WindowPtr;
  1248.             s:ARRAY[0..5] OF CHAR;
  1249.             signed,error:BOOLEAN;
  1250.             l:LONGINT;
  1251.             msgPtr:IntuiMessagePtr;
  1252.         BEGIN
  1253.           IF (i=vertC) OR (i=horzC) THEN
  1254.             signed:=TRUE;
  1255.             IF i=vertC THEN
  1256.               OpenNewWindow(wPtr,50,50,40,4,FlagSet{drag},
  1257.                           'Unterteilung der vert. Achse')
  1258.             ELSE
  1259.             OpenNewWindow(wPtr,50,50,40,4,FlagSet{drag},
  1260.                           'Unterteilung der horz.Achse')
  1261.             END;
  1262.             ModifyIDCMP(wPtr,(IDCMPFlagSet{closeWindow}+wPtr^.idcmpFlags));
  1263.             REPEAT
  1264.               IF i=vertC THEN
  1265.                 ReadString(wPtr,'Intervalle(0-60) ',s,4)
  1266.               ELSE
  1267.                 ReadString(wPtr,'Intervalle(0-100) ',s,4)
  1268.               END;
  1269.               IF s[0]#0C THEN
  1270.                 StrToVal(s,l,signed,10,error);
  1271.                 IF i=vertC THEN
  1272.                   error:=error OR (l<0) OR (l>60)
  1273.                 ELSE
  1274.                   error:=error OR (l<0) OR (l>100)
  1275.                 END;
  1276.                 IF error THEN
  1277.                   WriteString(wPtr,'Wert ist ungültig',TRUE);
  1278.                 END;
  1279.               END;
  1280.             UNTIL (NOT error) OR (NOT inputOK) OR (s[0]=0C);
  1281.             IF (NOT error) AND inputOK AND (s[0]#0C) THEN
  1282.               IF i=vertC THEN
  1283.                 yUnterteilung:=l
  1284.               ELSE
  1285.                 xUnterteilung:=l
  1286.               END
  1287.             END;
  1288.             CloseNewWindow(wPtr);
  1289.           ELSE
  1290.             IF i=vertV THEN
  1291.               yUnterteilung:=255
  1292.             ELSE
  1293.              xUnterteilung:=255
  1294.             END 
  1295.           END
  1296.         END XYIntervall;
  1297. (*************************************************************************)
  1298.         PROCEDURE DrawString;
  1299.           VAR
  1300.             qualifier:QualifierSet;
  1301.             msgPtr:IntuiMessagePtr;
  1302.             myText:IntuiText;
  1303.         BEGIN
  1304.           ModifyIDCMP(wPtr,wPtr^.idcmpFlags+IDCMPFlagSet{mouseButtons});
  1305.           LOOP
  1306.             (* alte IntuiMessages vernichten, z.B. IntuiTicks aus Drawing *)
  1307.             msgPtr:=GetMsg(wPtr^.userPort);
  1308.             IF msgPtr=NIL THEN
  1309.               EXIT
  1310.             ELSE
  1311.               ReplyMsg(msgPtr)
  1312.             END
  1313.           END;
  1314.           WaitPort(wPtr^.userPort);
  1315.           msgPtr:=GetMsg (wPtr^.userPort);
  1316.           IF msgPtr#NIL THEN
  1317.             qualifier:=msgPtr^.qualifier;
  1318.             ReplyMsg (msgPtr);
  1319.             IF (leftButton IN qualifier) AND
  1320.                 (eingaben[0].buffer[0]#0C) THEN
  1321.               WITH myText DO
  1322.                 frontPen:=textColor;
  1323.                 backPen:=backgroundColor;
  1324.                 drawMode:=jam1;
  1325.                 leftEdge:=0;
  1326.                 topEdge:=0;
  1327.                 iTextFont:=NIL;
  1328.                 iText:=ADR(eingaben[0].buffer);
  1329.                 nextText:=NIL;
  1330.               END;
  1331.               PrintIText(wPtr^.rPort,ADR(myText),wPtr^.mouseX,wPtr^.mouseY);
  1332.             END;
  1333.           END;
  1334.         END DrawString;
  1335. (*************************************************************************)
  1336.         PROCEDURE Save;
  1337.         BEGIN
  1338.         END Save;
  1339. (*************************************************************************)
  1340.         PROCEDURE Load;
  1341.         BEGIN
  1342.         END Load;
  1343. (*************************************************************************)
  1344.         PROCEDURE SetWindowToFront(b:BOOLEAN);
  1345.         BEGIN
  1346.           IF b THEN 
  1347.             WindowToFront(wPtr)
  1348.           ELSE
  1349.              WindowToBack(wPtr)
  1350.           END;
  1351.         END SetWindowToFront;
  1352. (*************************************************************************)
  1353.       BEGIN (*MenuReaction*)
  1354.         WHILE code#menuNull DO
  1355.           menuNr:=MenuNum(code);
  1356.           itemNr:=ItemNum(code);
  1357.           subNr:=SubNum(code);
  1358.           CASE menuNr OF
  1359.             0:CASE itemNr OF
  1360.               0:NewFunction|
  1361.               1:ClearScreen|
  1362.               2:CASE subNr OF
  1363.                     0:DefAreaMinMax(mmVar)|    
  1364.                     1:DefAreaMinMax(mmDef)
  1365.                   END|
  1366.               3:CASE subNr OF
  1367.                   0:DefAreaMinMax(defVar)|    
  1368.                   1:DefAreaMinMax(defDef)
  1369.                 END|
  1370.               4:CASE subNr OF
  1371.                   0:XYIntervall(horzV)|    
  1372.                   1:XYIntervall(horzC)
  1373.                 END|
  1374.               5:CASE subNr OF
  1375.                   0:XYIntervall(vertV)|    
  1376.                   1:XYIntervall(vertC)
  1377.                 END|
  1378.               6:Drawing|
  1379.               7:DrawString|
  1380.               8:ende:=TRUE
  1381.               END|
  1382.             1:CASE itemNr OF
  1383.                 0:backgroundColor:=subNr|
  1384.                 (*CASE subNr OF
  1385.                  0:backgroundColor:=0|
  1386.                 1:backgroundColor:=1|
  1387.                 2:backgroundColor:=2|
  1388.                     3:backgroundColor:=3
  1389.               END|
  1390.                 *)
  1391.                 1:drawingColor:=(subNr+1) MOD 4|
  1392.                 (*CASE subNr OF
  1393.                  0:drawingColor:=1|
  1394.                 1:drawingColor:=2|
  1395.                 2:drawingColor:=3|
  1396.                     3:drawingColor:=0
  1397.               END|
  1398.                 *)
  1399.                 2:textColor:=(subNr+1) MOD 4|
  1400.                 (*CASE subNr OF
  1401.                  0:textColor:=1|
  1402.                 1:textColor:=2|
  1403.                 2:textColor:=3|
  1404.                     3:textColor:=0
  1405.               END|
  1406.                 *)
  1407.                 3:CASE subNr OF
  1408.                     0:raster:=1|    
  1409.                     1:raster:=2|
  1410.                     2:raster:=4|
  1411.                     3:raster:=8
  1412.                   END|
  1413.                 4:CASE subNr OF
  1414.                     0:unit:=rad|    
  1415.                     1:unit:=deg|
  1416.                     2:unit:=gon
  1417.                   END|
  1418.                 5:CASE subNr OF
  1419.                     0:gitter:=FALSE|    
  1420.                     1:gitter:=TRUE
  1421.                   END|
  1422.                 6:CASE subNr OF
  1423.                     0:rahmen:=TRUE|    
  1424.                     1:rahmen:=FALSE
  1425.                   END|
  1426.                 7:CASE subNr OF
  1427.                     0:beschriftung:=TRUE|    
  1428.                     1:beschriftung:=FALSE
  1429.                   END|
  1430.               END|
  1431.             2:CASE itemNr OF
  1432.                 0:Load|
  1433.             1:Save|
  1434.             2:Hardcopy('s')|
  1435.                 3:Hardcopy('g')|
  1436.                 4:Hardcopy('p')|
  1437.                 5:CASE subNr OF
  1438.                     0:density:=SpecialSet{}|
  1439.                     1:density:=SpecialSet{density1}|
  1440.                     2:density:=SpecialSet{density2}|
  1441.                     3:density:=SpecialSet{density1,density2}|
  1442.                     4:density:=SpecialSet{density4}|
  1443.                   END|
  1444.                 6:standartXSize:=subNr+1|
  1445.                 (*CASE subNr OF
  1446.                     0:standartXSize:=1|
  1447.                     1:standartXSize:=2|
  1448.                     2:standartXSize:=3|
  1449.                     3:standartXSize:=4|
  1450.                   END|
  1451.                 *)
  1452.                 7:standartYSize:=subNr+1|
  1453.                 (*CASE subNr OF
  1454.                     0:standartYSize:=1|
  1455.                     1:standartYSize:=2|
  1456.                     2:standartYSize:=3|
  1457.                     3:standartYSize:=4|
  1458.                   END|
  1459.                 *)
  1460.               END|
  1461.             3:CASE itemNr OF
  1462.                 0:SetWindowToFront(FALSE)|
  1463.                 1:SetWindowToFront(TRUE)
  1464.               END
  1465.           END;  
  1466.           menuIPtr:=ItemAddress(firstMenu,code);
  1467.           code:=menuIPtr^.nextSelect;
  1468.         END;
  1469.       END MenuReaction;
  1470. (*************************************************************************)
  1471.     BEGIN
  1472.       ende:=FALSE;
  1473.       WaitPort(wPtr^.userPort);
  1474.       msgPtr:=GetMsg (wPtr^.userPort); 
  1475.       IF msgPtr <> NIL THEN
  1476.         class:=msgPtr^.class;
  1477.         code :=msgPtr^.code;
  1478.         ReplyMsg(msgPtr);
  1479.         IF class=IDCMPFlagSet{menuPick} THEN
  1480.           MenuReaction
  1481.         END
  1482.       END
  1483.     END RespondMessage;
  1484. (*************************************************************************)
  1485.   BEGIN
  1486.     wPtr:=NIL;
  1487.     TermProcedure(CleanupGraph);
  1488.     Init;
  1489.     OpenGraphicWindow;
  1490.     actWSize:= wPtr^.wScreen^.height;
  1491.     SizeWindow(wPtr,0,actWSize-maxVertRes);
  1492.     InitGraphicmenu;
  1493.     IF SetMenuStrip(wPtr,firstMenu) THEN END;
  1494.     maxVertRes:=actWSize;
  1495.     CharSize(charWidth,charHeight);
  1496.     horzRes:=MaxHorzRes-charWidth*Zahlenstellen-zwei*2;
  1497.     IF NOT ODD(horzRes) THEN
  1498.       DEC(horzRes)
  1499.     END;
  1500.     vertRes:=maxVertRes-charHeight-zwei*2;
  1501.     IF NOT ODD(vertRes) THEN (* Damit die x-Achse, wenn sie in der Mitte liegt
  1502.                     auch wirklich in der Mitte liegt *)
  1503.       DEC(vertRes)
  1504.     END;
  1505.     ffpVertRes:=FFP(vertRes);
  1506.     ClearScreen;
  1507.     REPEAT 
  1508.       RespondMessage;
  1509.     UNTIL ende;
  1510.     CleanupGraph;
  1511.   END Graf;
  1512. BEGIN
  1513.   WITH eingaben[0] DO
  1514.     buffer:='';
  1515.     text:='Funktion:';
  1516.     sichtbareZeichen:=40;
  1517.   END;
  1518.   WITH eingaben[1] DO
  1519.     buffer:='';
  1520.     text:='Laufvariable:';
  1521.     sichtbareZeichen:=2;
  1522.   END;
  1523.   WITH eingaben[2] DO
  1524.     buffer:='';
  1525.     text:='Startwert:';
  1526.     sichtbareZeichen:=20;
  1527.   END;
  1528.   WITH eingaben[3] DO
  1529.     buffer:='';
  1530.     text:='Endwert:';
  1531.     sichtbareZeichen:=20;
  1532.   END;
  1533. END Graph.mod
  1534.